In   -
Out  CLIPrompt
Type Module
Ver  1.03p

Define Workspace
 Name      block
 Default   r12
  `next    !    pointer to the next one
  `modws   !    pointer to module workspace
  `domain  !    this domain id
  `epc     !    PC when error generated
  `enum    !    error number (main buffer)
  `etext   !62  error text
  `hands   !16  handler space
  `line    !64  line buffer
  `cliblk  !8   cli exit handler
  `stack   !256 some stack space (1k)

 Name      module
 Default   r12
  `memlist !  memory list
End Workspace

Define Module
 Name      CLIPrompt
 Author    Justin Fletcher
 Commands
  Name     CLIPrompt
  Help     ...
           *CLIPrompt is used to obtain a simple command line prompt which
           you can use within a taskwindow or similar environment. Example
           commands you might use include *TaskWindow CLIPrompt -quit and
           *WimpTask CLIPrompt. To exit the prompt window, type Quit.
  Code     com_cliprompt
 End Commands
 Start     mod_start
 Services
  WimpCloseDown        svc_wimpclosedown ; to trap closing tasks
 End Services
 Workspace *`len_module
End Module

Pre
 #Cond Set Handlers True
End Pre

#Rem Off
; *******************************************************************
; Subroutine:   svc_wimpclosedown (Wimp_CloseDown)
; Description:  Checks if the task closing down is one we have a block for
; Parameters:   r0 = 0 if closing down
;               r2 = task handle (unused)
; Returns:      none
; *******************************************************************
>svc_wimpclosedown
   STMFD   (sp)!,{r0-r5,link}            ; Stack registers
   REM     "%c04%c30Closing down, r0=%&0"
   CMP     r0,#0                         ; is it closedown ?
   BLEQ    killcurrent                   ; if so, kill it !
   LDMFD   (sp)!,{r0-r5,pc}^             ; Return from call

; the *CLIPrompt command
>com_cliprompt
   XSWI    "XOS_Module",2,^module_title,0 ; enter our module
   SWI     "OS_Exit"                     ; exit

; kill the current session if any
>killcurrent
   STMFD   (sp)!,{r0-r5,link}            ; Stack registers
   MOV     r3,#0                         ; Address of DomainId
   LDR     r3,[r3,#&FF8]                 ; read domain id
   REM     "Task was %&3"
   ADRW    r1,`memlist                   ; address of task list
   LDR     r0,[r1]                       ; read the list entry
#MapWS block,r0
$loop
   REM     "New pointer %&0"
   CMP     r0,#0                         ; is there nothing in list
   BEQ     $exit                         ; if so, jump out
   LDR     r4,[r0]                       ; read the 'next' entry
   LDRW    r2,`domain                    ; read the domain of that task
   REM     "Block DomainId = %&2"
   CMP     r2,r3                         ; is this the one dying ?
   BNE     $notdying                     ; nope, so skip...
   REM     "Found it, killing"
   XBL     release                       ; release the workspace
   STR     r4,[r1]                       ; store 'next' over previous 'next'
   MOV     r0,r1                         ; current = last
$notdying
   MOV     r1,r0                         ; last = current
   MOV     r0,r4                         ; current = next
   B       $loop
$exit
#MapWS block
   LDMFD   (sp)!,{r0-r5,pc}              ; Return from call

.`claimfailed
   EQUD    0
   EQUZA   "Not enough memory to start application"

; start a new application by entering the module
>mod_start
; claim space
   LMOV    r3,`len_block                 ; the block length
   XSWI    "XOS_Module",6                ; claim space
   MOVVC   r0,r2                         ; r0-> space
   ADRVS   r0,`claimfailed               ; failed, so here's the message
   SWIVS   "OS_GenerateError"            ;        and exit with a fatal error

; link us in
   STR     r12,[r0,#`modws]              ; store the module ws in block
   LDRW    r2,`memlist                   ; read the list head
   STR     r2,[r0,#`next]                ; link it on
   STRW    r0,`memlist                   ; make us the head
   MOV     r12,r0                        ; r12-> our block
   MOV     r2,#0                         ; base
   LDR     r2,[r2,#&FF8]                 ; read domain id
   STRW    r2,`domain                    ; store domain id

   ADRW    r13,`stack                    ; address of our stack
   ADD     r13,r13,#1024                 ; add on the size
   REM     "R12 = %&C"
#cond of handlers
   ADRW    r4,`hands                     ; address to stack handlers at
   ADRW    r3,`epc                       ; error buffer start
   XSWI    "XOS_ChangeEnvironment",6,^hand_error,r12    ; error handler
   STMIA   r4!,{r0-r3}                   ; stack handlers
   XSWI    "XOS_ChangeEnvironment",11,^hand_exit,r12    ; exit handler
   STMIA   r4!,{r0-r3}                   ; stack handlers
;    XSWI    "XOS_ChangeEnvironment",15,^hand_exit,r12    ; CAO
;    STMIA   r4!,{r0-r3}                   ; stack handlers
#cond endif

.returnloop
; write the prompt
   ADRW    r1,`line                      ; use the line buffer for the var
   XSWI    "XOS_ReadVarVal",^$`eclivar,,256,0,3 ; read extended CLI var
   BVC     $eknown                       ; if ok, we use extended CLI
   XSWI    "XOS_ReadVarVal",^$`clivar,,256,0,3 ; read it
   BVS     $notknown                     ; if error, then we print just star
$eknown
   XSWI    "OS_WriteN",r1,r2             ; write the string
   B       $skipstar
$notknown
   SWI     &100+ASC("*")                 ; if not found, write *
$skipstar
   BVS     exit                          ; if either failed we should exit
; do readline
   ADRW    r0,`line                      ; address of line
   XSWI    "XOS_ReadLine",,256,32,255    ; read the line
   BVS     exit                          ; if error, exit
   BCS     $escape                       ; escape pressed
   ADR     r1,$`quit                     ; quit
   BL      cmpstringi                    ; compare 'em
   BEQ     exit                          ; if same, exit
   BL      installcliexit
   XSWI    "XOS_CLI"                     ; call the command
   BL      removecliexit
   BVC     returnloop                    ; go around more
   SWI     "OS_NewLine"                  ; write a new line
   ADD     r0,r0,#4                      ; add on 4
   SWI     "OS_Write0"                   ; write the message
   SWI     "OS_NewLine"                  ; and a newline
   B       returnloop                    ; and go around

$escape
   XSWI    "OS_Byte",&7C                 ; clear escape condition
   SWI     "OS_NewLine"                  ; write newline
   SWI     "OS_NewLine"                  ; write newline
   SWI     "OS_WriteS"                   ; write the message
   EQUZA   "Escape"
   SWI     "OS_NewLine"
   B       returnloop                    ; and go for more

$`escmsg
   EQUD    17
   EQUZA   "Escape"

$`quit
   EQUZ    "QUIT"
$`eclivar
   EQUS    "E"
$`clivar
   EQUZA   "CLI$Prompt"

>exit
   BL      restoreenv
; and finally exit...
   REM     "Exiting, R12 = %&C"
   LDRW    r12,`modws                    ; load the module ws pointer
   BL      killcurrent                   ; kill the current from the list
   SWI     "OS_Exit"

; restore the environment
>restoreenv
   STMFD   (sp)!,{r0-r4,link}            ; Stack registers
#cond of handlers
   ADRW    r4,`hands                     ; address to stack handlers at
   LDMIA   r4!,{r0-r3}                   ; unstack handlers
   REM     "Restoring handler %r0"
   SWI     "XOS_ChangeEnvironment"       ; error handler
   LDMIA   r4!,{r0-r3}                   ; unstack handlers
   REM     "Restoring handler %r0"
   SWI     "XOS_ChangeEnvironment"       ; escape handler
;    LDMIA   r4!,{r0-r3}                   ; unstack handlers
;    REM     "Restoring handler %r0"
;    SWI     "XOS_ChangeEnvironment"       ; exit handler
#cond endif
   LDMFD   (sp)!,{r0-r4,pc}              ; Return from call

>hand_error
   MOV     r12,r0                        ; r12 = our workspace
   ADRW    r13,`stack                    ; address of our stack
   ADD     r13,r13,#1024                 ; add on the size
   SWI     "OS_NewLine"
   ADRW    r0,`enum                      ; pointer to error
   REMP    "%E0"                         ; the error
   BL      restoreenv                    ; restore the environment
   LDRW    r12,`modws                    ; load the module ws pointer
   BL      killcurrent                   ; kill the current one
   SWI     "OS_GenerateError"            ; generate error

>hand_exit
   B       exit
;    B       returnloop                    ; let's go some more...

>installcliexit
   STMFD   (sp)!,{r0-r5,link}            ; Stack registers
   ADRW    r4,`cliblk                    ; store the exit
   XSWI    "XOS_ChangeEnvironment",11,^cli_exit,r12 ; exit handler
   STMIA   r4!,{r0-r3}                   ; stack handlers
   ADRW    r3,`epc                       ; error buffer start
   XSWI    "XOS_ChangeEnvironment",6,^cli_error,r12 ; error handler
   STMIA   r4!,{r0-r3}                   ; stack handlers
   LDMFD   (sp)!,{r0-r5,pc}              ; Return from call

>removecliexit
   STMFD   (sp)!,{r0-r5,link}            ; Stack registers
   ADRW    r4,`cliblk                    ; store the exit
   LDMIA   r4!,{r0-r3}                   ; stack handlers
   XSWI    "XOS_ChangeEnvironment"       ; exit handler
   LDMIA   r4!,{r0-r3}                   ; stack handlers
   XSWI    "XOS_ChangeEnvironment"       ; exit handler
   LDMFD   (sp)!,{r0-r5,pc}^             ; Return from call

>cli_exit
   BL      removecliexit                 ; remove handler
   B       returnloop                    ; and return

>cli_error
   MOV     r12,r0                        ; r12 = our workspace
   ADRW    r13,`stack                    ; address of our stack
   ADD     r13,r13,#1024                 ; add on the size
   BL      removecliexit                 ; remove handler
   SWI     "OS_NewLine"
   ADRW    r0,`enum                      ; pointer to error
   REMP    "%E0"                         ; the error
   B       returnloop                    ; and return

#Library "Strings",cmpstringi
#Library "Memory",claim.release
#here Libraries

#Post
*SetMacro ECli$Prompt [<Sys$Time>] CLIPrompt *
#Run <CODE>
